home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / hk / bassrc / hk4in.bas < prev    next >
BASIC Source File  |  1993-07-08  |  31KB  |  813 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HK4IN.BAS  Copyrigit(C) T.Komura     / 家計簿システム      /
  3. 30 '                                       /          Version 4  /
  4. 31 '  Version 4.0  1992.06.20-1992.06.28   / 入力･編集プログラム /
  5. 32 '                                       /                     /
  6. 100 '------------------------------------------------------------------
  7. 150 DIM CFI$(15)
  8. 170 GOSUB *CONFIGファイルチェック
  9. 190 '
  10. 193 VERN$="1.0" 'バージョンNo.
  11. 200 *初期設定:'--------------------------------------------------------
  12. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  13. 220 SCREEN@ 0 :COLOR 7,0,0,4:CLS:CONSOLE 0,24,0:MOUSE 0
  14. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  15. 235 DIM  L_W$(80)
  16. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  17. 250 PLAY "@30T150V6":DATX$=DATE$
  18. 260 DIM XB1(3,25),XB2(3,25),YB1(3,25),YB2(3,25),BST(3,25)
  19. 270 DIM DYN$(16),DRM$(16),DYN(16)
  20. 300 INTERVAL 1                  :'プログラム先頭
  21. 310 ON INTERVAL GOSUB *時計表示 :'プログラム先頭 
  22. 320 GOSUB *ボタン座標読み取り
  23. 330 'CLS:COLOR 7:PRINT int((int(((630-234+1)+7)/8)*(97-71+1)*4+8-1)/8)
  24. 350 DIM CUTN#(795)
  25. 370 ON ERROR GOTO *ERROR
  26. 380 '
  27. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  28. 1005 GOSUB *表紙表示:CONSOLE 0,24,2
  29. 1010 MESN=18:GOSUB *SNDMSG
  30. 1015 MESN=1:GOSUB *MESDSP
  31. 1020 GOSUB *本日の日付
  32. 1030 GOSUB *日付表示
  33. 1040 MOUSE 1,320,64,1
  34. 1050 GOSUB *指定日データ表示
  35. 1100 *メイン選択
  36. 1110 IF MES2OFF=0 THEN MESN=2:GOSUB *MESDSP
  37. 1130 SWPASS=1:G=1:GOSUB *マウスボタン選択
  38. 1145 IF SWNO>=10 THEN *SSEL
  39. 1150 ON SWNO GOTO *S01,*S02,*S03,*S04,*S05,*S06,*S07,*S08,*S09
  40. 1160 GOTO 1100:STOP
  41. 3490 '
  42. 3500 *S01:' 1年先 ---------------------------------------------------
  43. 3505  YDEF=+1:MDEF= 0:DDEF= 0: GOTO *YMDRNEW
  44. 3510 *S02:' 1年前 ---------------------------------------------------
  45. 3515  YDEF=-1:MDEF= 0:DDEF= 0: GOTO *YMDRNEW
  46. 3520 *S03:' 1月先 ---------------------------------------------------
  47. 3525  YDEF= 0:MDEF=+1:DDEF= 0: GOTO *YMDRNEW
  48. 3530 *S04:' 1月前 ---------------------------------------------------
  49. 3535  YDEF= 0:MDEF=-1:DDEF= 0: GOTO *YMDRNEW
  50. 3540 *S05:' 1日先 ---------------------------------------------------
  51. 3545  YDEF= 0:MDEF= 0:DDEF=+1: GOTO *YMDRNEW
  52. 3550 *S06:' 1日前 ---------------------------------------------------
  53. 3555  YDEF= 0:MDEF= 0:DDEF=-1: GOTO *YMDRNEW
  54. 3560 '
  55. 3570 *YMDRNEW
  56. 3572  SWNOX=SWNO
  57. 3575  G=1:B=SWNOX:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  58. 3580  IF IPF=0 THEN 3610
  59. 3585  MESN=4:GOSUB *MESDSP
  60. 3590  CMES$="家計簿データ保存実行":GOSUB *確認
  61. 3600  IF SWNO=2 THEN 3610
  62. 3605  GOSUB *家計簿データ保存
  63. 3610  GOSUB *年月日変更
  64. 3620  GOSUB *日付表示
  65. 3650  MESN=6:GOSUB *MESDSP
  66. 3660  GOSUB *指定日データ表示
  67. 3670  IPF=0
  68. 3680  G=1:B=SWNOX:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  69. 3690  GOTO *メイン選択
  70. 3695 '
  71. 3700 *SSEL:'------------------------------------------------------------
  72. 3720  G=1:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  73. 3730  IPNO=B-10
  74. 3740  IF IPNO=0 THEN GOSUB *出来事入力   :GOTO 3900
  75. 3760                 GOSUB *金額･内容入力:GOTO 3900
  76. 3900  IPF=1
  77. 3910  G=1:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  78. 3980  MES2OFF=0
  79. 3990  GOTO *メイン選択
  80. 3995 '
  81. 4000 *S07:'取消 --------------------------------------------------------
  82. 4010  G=1:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示 
  83. 4020  MESN=6:GOSUB *MESDSP
  84. 4030  GOSUB *指定日データ表示
  85. 4035  IPF=0
  86. 4040  G=1:B=SWNO:BST(G,B)=0:GOSUB *ボタンON_OFF表示
  87. 4050  GOTO *メイン選択
  88. 4060 '
  89. 4500 *S08:'保存 --------------------------------------------------------
  90. 4510  GOSUB *家計簿データ保存
  91. 4580  GOTO *メイン選択
  92. 4590 '
  93. 8940 '
  94. 9000 *S09:'終了････････････････････････････････････････････････････････
  95. 9020 G=1:B=9:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  96. 9030  IF IPF=0 THEN 9110
  97. 9035  MESN=4:GOSUB *MESDSP
  98. 9040  CMES$="家計簿データ保存実行":GOSUB *確認
  99. 9045  IF SWNO=2 THEN 9110
  100. 9050  GOSUB *家計簿データ保存
  101. 9060 '
  102. 9110 MESN=9:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  103. 9120 INTERVAL OFF
  104. 9130 'MOUSE 5:GOSUB *FADEOUT
  105. 9150 CHAIN "hk4main.bas"
  106. 9160 '
  107. 9900 '-------------------------------------------------------------------
  108. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  109. 9920 '-------------------------------------------------------------------
  110. 10000 *CHR1IN:'////////// 1文字入力
  111. 10010  A$=INKEY$:IF A$="" THEN 10010
  112. 10020  A=INSTR(C$,A$)
  113. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  114. 10040  RETURN
  115. 10050 '
  116. 10060 '
  117. 10070 *MESDSP:'////////// メッセージ表示
  118. 10080  RESTORE *MESDAT
  119. 10090  FOR IM=1 TO MESN:READ XM,YM,CM,CB,BM,MES$:NEXT IM
  120. 10100  LOCATE 0,YM:COLOR CB,CB:PRINT SPACE$(79);
  121. 10110  LOCATE XM,YM:COLOR CM,CB:PRINT MES$;
  122. 10120  'IF BM=1 THEN PLAY "L4O4A"
  123. 10130  RETURN
  124. 10140 '
  125. 10200 *MESDAT:'////////// メッセージデータ
  126. 10205 '    XM, YN, CM, CB, BM
  127. 10210 DATA  2, 23,  5,  0,  1 :'--- 01
  128. 10215 DATA "                     - HK version 4.0 - 記入･編集            [HKIN.BAS L10]"
  129. 10220 DATA  2, 23,  7,  0,  0 :'--- 02
  130. 10225 DATA "適当なボタンをマウスカーソルで押して(左ｸﾘｯｸ)ください｡"
  131. 10230 DATA  2, 23,  6,  0,  0 :'--- 03
  132. 10235 DATA "ディスクにこの月の家計簿ファイルがありません｡新しくファイルを作りますか?"
  133. 10240 DATA  2, 23,  6,  0,  1 :'--- 04
  134. 10245 DATA "家計簿データが保存されていません！  保存する--[OK] 保存しない--[NG]"
  135. 10250 DATA  2, 23,  4,  0,  1 :'--- 05
  136. 10255 DATA "★家計簿ファイル新規作成中 !!"
  137. 10260 DATA  2, 23,  4,  0,  1 :'--- 06
  138. 10265 DATA "★家計簿ファイル読み込み中 !!"
  139. 10270 DATA  2, 23,  6,  0,  0 :'--- 07
  140. 10275 DATA "家計簿ファイルが無いため､この月のデータは読み込みできません!"
  141. 10280 DATA  2, 23,  7,  0,  0 :'--- 08
  142. 10285 DATA "このデータを家計簿ファイルに書き込んでよろしいですか? [OK],[NG]"
  143. 10290 DATA  2, 23,  5,  0,  1 :'--- 09
  144. 10295 DATA "       ★★★  しばらくお待ちください｡"
  145. 10300 DATA  2, 23,  7,  0,  0 :'--- 10
  146. 10305 DATA "[ファイル記入･訂正] -- 出来事を記入してください｡"
  147. 10310 DATA  2, 23,  7,  0,  0 :'--- 11
  148. 10315 DATA "[ファイル記入･訂正] -- 金額を記入してください｡"
  149. 10320 DATA  2, 23,  7,  0,  0 :'--- 12
  150. 10325 DATA "[ファイル記入･訂正] -- 内容を記入してください｡"
  151. 10330 DATA  2, 23,  4,  0,  1 :'--- 13
  152. 10335 DATA "★家計簿ファイル書き込み中"
  153. 10990 '
  154. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  155. 11005  IF SNDMF=0 THEN RETURN
  156. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  157. 11020  '                   入力=MESN (メッセージNo.)
  158. 11030  '
  159. 11070  IF MESN>36 THEN *RETURN_SNDMSG 
  160. 11080  RESTORE *MSGNAM
  161. 11090  FOR IMSG=1 TO MESN
  162. 11100    READ MSGD$
  163. 11110  NEXT IMSG
  164. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  165. 11130  LOAD@ MSGFN$,MSGD%
  166. 11140  PCMPLAY MSGD%
  167. 11150 *RETURN_SNDMSG :WAIT SWAIT:RETURN
  168. 11160 *MSGNAM :'////////// .SND File Name Data
  169. 11170 DATA "OHA1"   :'  1 おはよう
  170. 11180 DATA "KONN"   :'  2 こんにちわ
  171. 11190 DATA "KONBAN" :'  3 こんばんわ
  172. 11200 DATA "GOKRO1" :'  4 ごくろうさん
  173. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  174. 11220 DATA "OTUKA"  :'  6 お疲れさま
  175. 11230 DATA "OMATA"  :'  7 おまたせ
  176. 11240 DATA "ARIGA2" :'  8 ありがとう
  177. 11250 DATA "RUNRUN" :'  9 るんるん
  178. 11260 DATA "DAMEDE" :' 10 だめでしょう
  179. 11270 DATA "IIDE1"  :' 11 いいですか
  180. 11280 DATA "NANISI" :' 12 なにしてるの
  181. 11290 DATA "DAMEDA" :' 13 だめだめ
  182. 11300 DATA "OWARI"  :' 14 終わりました
  183. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  184. 11320 DATA "YOROSI" :' 16 よろしいですか
  185. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  186. 11340 DATA "ERANDE" :' 18 選んでください
  187. 11350 DATA "KAKNIN" :' 19 確認して下さい
  188. 11360 DATA "NYURYO" :' 20 入力してください
  189. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  190. 11380 DATA "OYASUM" :' 22 おやすみ
  191. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  192. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  193. 11410 DATA "OOKINA" :' 25 大きな間違い
  194. 11420 DATA "YAMETE" :' 26 やめて
  195. 11430 DATA "TIGAU"  :' 27 ちがうよ
  196. 11440 DATA "PINPON" :' 28 ぴんぽーん
  197. 11450 DATA "BUU"    :' 29 ぶー
  198. 11460 DATA "MOUII"  :' 30 もういいよう  
  199. 11470 DATA "DEKITA" :' 31 できたよー
  200. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  201. 11490 DATA "YOSI"   :' 33 よしなさい
  202. 11500 DATA "OYOSI"  :' 34 およしなさい
  203. 11510 DATA "YAMENA" :' 35 やめなさい
  204. 11520 DATA "GOMEN"  :' 36 ごめん
  205. 11530 '                                    
  206. 12000 '////////// 年月日入力 & 曜日表示
  207. 12010 '                    
  208. 12045 *週検索
  209. 12050 DATA "日",2,"月",0,"火",0,"水",0,"木",0,"金",0,"土",5
  210. 12060 GOSUB *WEEKN:RESTORE 12050:FOR IW=0 TO WK:READ WKM$,CW:NEXT IW
  211. 12080 RETURN
  212. 12090 '
  213. 12100 *YMDIN            '  V2.0  1991.07.21
  214. 12110 LX=XYMD:LY=YYMD:LC=CYMD:LL=4:LM$=INYR$
  215. 12120 LOCATE LX,LY:COLOR BYMD:PRINT "    年   月  日";
  216. 12130 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INYR$=LMG$
  217. 12140 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  218. 12145 YR=VAL(INYR$)
  219. 12150 LX=XYMD+7:LY=YYMD:LC=CYMD:LL=2:LM$=INMN$
  220. 12160 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INMN$=LMG$
  221. 12170 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  222. 12175 MN=VAL(INMN$):IF MN<1 OR MN>12 THEN BEEP:GOTO 12160
  223. 12180 LX=XYMD+11:LY=YYMD:LC=CYMD:LL=2:LM$=INDY$
  224. 12190 LOCATE LX,LY:COLOR CYMD:PRINT LM$:GOSUB *LKEYIN: INDY$=LMG$
  225. 12200 LOCATE LX,LY:COLOR AYMD:PRINT LMG$
  226. 12205 DY=VAL(INDY$):IF DY<1 OR DY>31 THEN BEEP:GOTO 12190
  227. 12210 RETURN
  228. 12220 '
  229. 12450 *WEEKN :'////////// 週NO.検索
  230. 12460 U=0    :'････････････････････････ Input; YR MN   Output; WK DN
  231. 12470 IF YR/4-INT(YR/4)=0 THEN U=1
  232. 12480 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  233. 12490 DATA 31,29,31,30,31,30,31,31,30,31,30,31
  234. 12500 IF U=0 THEN RESTORE 12480 ELSE RESTORE 12490
  235. 12505 IF MN=1 THEN MDN=0:MNDN=31:GOTO 12520
  236. 12510 MDN=0:FOR IWEKN=1 TO MN-1:READ DN:MDN=MDN+DN:NEXT IWEKN
  237. 12515 READ MNDN:'当月の日数
  238. 12520 YDN#=MDN+YR*365+INT((YR+3)/4)+5+DY-1
  239. 12530 WK=(YDN#/7-INT(YDN#/7))*7
  240. 12540 RETURN
  241. 13000 '                                          1993.02.12 T.Komura
  242. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  243. 13020 ' v1.1a   入力 = LX,LY : 表示開始座標  出力 = LMG$ : 入力後の文字列
  244. 13030 '                LM$   : 初期文字列
  245. 13040 '                LC    : 表示文字色
  246. 13050 '                LL    : 最大文字数
  247. 13060 '
  248. 13070 LCSRCL=2:LLINCL=6
  249. 13080 '      CR   MR   ML  INS  DEL   BS  CAN
  250. 13085 LMSX=MOUSE(0):LMSY=MOUSE(1):MOUSE 5     :'v1.1a
  251. 13090 CC$=CHR$(&H0D,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  252. 13100 LMG$=SPACE$(LL):LMGD$=SPACE$(LL)
  253. 13110 LA$=INKEY$:IF LA$<>"" THEN 13110
  254. 13120 LCSR=0:LCSRX=LCSR:GOSUB *LCSRDX
  255. 13130 LOCATE LX,LY:COLOR LC:PRINT LM$ '        ･･････････ 初期文字列記憶
  256. 13140 LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  257. 13150 LMX$=LEFT$(LM$+SPACE$(LL),LL)
  258. 13160 GOSUB *LMREAD
  259. 13170 *IN1C:'                                  ･･････････ 1 文字入力
  260. 13180 LA$=INKEY$:IF LA$="" THEN 13180
  261. 13190 ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  262. 13200 IF CLA=0 THEN 13220
  263. 13210 ON CLA GOTO *CR,*MR,*ML,*INS,*DEL,*BS,*CAN
  264. 13220 IF KANF=1 THEN *KANJI
  265. 13230 IF ALA<&H20 THEN BEEP:GOTO *IN1C
  266. 13240 IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  267. 13250 IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  268. 13260 GOTO *KANJI
  269. 13270 *ANK :'                                  ･･････････ ANK 文字入力
  270. 13280 LOCATE LX+LCSR,LY:COLOR LC:PRINT LA$
  271. 13290 MID$(LMX$,LCSR+1,1)=LA$
  272. 13300 GOSUB *LCSRINC:GOTO *IN1C
  273. 13310 *KANJI :'                                ･･････････ 漢字文字入力
  274. 13320 ON KANF+1 GOTO 13330,13360
  275. 13330 KANF=1:KANW$="":KANW$=LA$
  276. 13340 IF LCSR+1>=LL THEN KANF=0:BEEP
  277. 13350 GOSUB *LCSRD:GOTO *IN1C
  278. 13360 KANF=0:KANW$=KANW$+LA$
  279. 13370 LOCATE LX+LCSR,LY:COLOR LC:PRINT KANW$
  280. 13380 MID$(LMX$,LCSR+1,2)=KANW$
  281. 13390 GOSUB *LCSR2INC:GOTO *IN1C
  282. 13400 *CR :GOSUB *LMREAD :GOSUB *LCSRDX         '////////// End
  283. 13410 LINE(LX*8,LY*19+16)-((LX+LL)*8,LY*19+17),XOR,LLINCL,BF
  284. 13415 MOUSE 0: MOUSE 1,LMSX,LMSY,1              :'v1.1a
  285. 13420 RETURN:'----------------------------------------------------------
  286. 13430 *MR :GOSUB *LCSRINC                       '////////// Right
  287. 13440 GOTO *IN1C
  288. 13450 *ML :GOSUB *LCSRDEC                       '////////// Left
  289. 13460 GOTO *IN1C
  290. 13470 *INS:GOSUB *LMREAD                       '////////// Insert
  291. 13480 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  292. 13490 LMX$=LEFT$(LMG$,LCSR)+" "+MID$(LMG$,LCSR+1,LL-1-LCSR)
  293. 13500 GOSUB *LMXDSP
  294. 13510 GOTO *IN1C
  295. 13520 *DEL:GOSUB *LMREAD                       '////////// Delete
  296. 13530 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  297. 13540 IF LMGF$="1" THEN 13560
  298. 13550 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+2,LL-1-LCSR)+" ":GOTO 13570
  299. 13560 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+3,LL-2-LCSR)+"  "
  300. 13570 GOSUB *LMREAD
  301. 13580 GOSUB *LMXDSP:GOTO *IN1C
  302. 13590 *BS :GOSUB *LMREAD                       '////////// BackSpace
  303. 13600 IF LCSR=0 THEN BEEP:GOTO *IN1C
  304. 13610 IF LMGF$="2" THEN BEEP:GOTO *IN1C
  305. 13620 GOSUB *LCSRDEC:GOSUB *LMREAD:LMGFX$=LMGF$
  306. 13630 LMX$=LEFT$(LMG$,LCSR)+MID$(LMG$,LCSR+2,LL-1-LCSR)+" "
  307. 13640 IF LMGFX$="2" THEN LMGFX$="0":GOSUB *LMREAD:GOTO 13620
  308. 13650 GOSUB *LMXDSP
  309. 13660 GOTO *IN1C
  310. 13670 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  311. 13680 GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  312. 13690 GOSUB *LMREAD:GOTO *IN1C
  313. 13700 *LMREAD:                                 '////////// Disp Char Read 
  314. 13710 LMDX=0:LMGD$=""
  315. 13720 FOR II=1 TO LL
  316. 13730   LMG=ASC(MID$(LMX$,II,1))
  317. 13740   IF (LMG>=&H80) AND (LMG<&HA0) THEN LMDK=1 ELSE LMDK=0
  318. 13750   IF LMDX=1            THEN LMD$="2":LMDX=0:GOTO 13780
  319. 13760   IF LMDK=1 AND LMDX=0 THEN LMD$="1":LMDX=1:GOTO 13780
  320. 13770   IF LMDK=0 THEN            LMD$="0":LMDX=0
  321. 13780   LMGD$=LMGD$+LMD$
  322. 13790 NEXT II:LMGF$=MID$(LMGD$,LCSR+1,1):LMG$=LMX$
  323. 13800 RETURN
  324. 13810 *LCSRD :LXC=8*(LX+LCSR) :LYC=LY*19:GOSUB 13840: '//// Csr Disp
  325. 13820 *LCSRDX:LXC=8*(LX+LCSRX):LYC=LY*19:GOSUB 13840: '//// Csr Erace
  326. 13830 LCSRX=LCSR:RETURN
  327. 13840 LINE(LXC,LYC+0)-(LXC+1,LYC+14),XOR,LCSRCL,BF:RETURN
  328. 13850 *LCSRINC :LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1
  329. 13860 GOSUB *LCSRD:RETURN
  330. 13870 *LCSR2INC:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2
  331. 13880 GOSUB *LCSRD:RETURN
  332. 13890 *LCSRDEC :LCSR=LCSR-1:IF LCSR<0   THEN LCSR=0
  333. 13900 GOSUB *LCSRD:RETURN
  334. 13910 *LMXDSP:LOCATE LX,LY:COLOR LC:PRINT LMX$;:RETURN
  335. 15000 '
  336. 15010 '  SAVE"TCLOCK.sub"             :'   組み込み型 アナログ時計 V1.1
  337. 15020 '                                       1991.05 T.KOMURA 
  338. 15030 '--------------------------------------------------------------------
  339. 15040 '
  340. 15220 *時計表示:'///////////////////////////////////
  341. 15230 XCLK0=572:YCLK0=22:CLKR=16:PI=3.1415!
  342. 15240 TIMEX$=TIME$:IF DATE$<>DATX$ THEN GOSUB *本日の日付
  343. 15250 TSC$=MID$(TIMEX$,7,2):SCR=2*PI*(VAL(TSC$)/60)
  344. 15260 TMN$=MID$(TIMEX$,4,2):MNR=2*PI*(VAL(TMN$)/60)
  345. 15270 THR$=LEFT$(TIMEX$,2) :HRR=2*PI*((VAL(THR$)*60+VAL(TMN$))/720)
  346. 15280 GOSUB *短針表示
  347. 15290 GOSUB *長針表示
  348. 15300 GOSUB *秒針表示
  349. 15310 CLOCKINIT=1:DATX$=DATE$
  350. 15320 RETURN
  351. 15330 '
  352. 15340 *短針表示
  353. 15350 XHD1=XCLK0+(CLKR-8)*SIN(HRR):XHD2=XCLK0
  354. 15360 YHD1=YCLK0-(CLKR-8)*COS(HRR):YHD2=YCLK0
  355. 15370 IF CLOCKINIT=0 THEN 15400
  356. 15380 IF SCR<>0 THEN 15420
  357. 15390 LINE(XHD1X,YHD1X)-(XHD2X,YHD2X),XOR,6
  358. 15400 LINE(XHD1 ,YHD1 )-(XHD2 ,YHD2 ),XOR,6
  359. 15410 XHD1X=XHD1:YHD1X=YHD1:XHD2X=XHD2:YHD2X=YHD2
  360. 15420 RETURN
  361. 15430 *長針表示
  362. 15440 XMD1=XCLK0+(CLKR-2)*SIN(MNR):XMD2=XCLK0
  363. 15450 YMD1=YCLK0-(CLKR-2)*COS(MNR):YMD2=YCLK0
  364. 15460 IF CLOCKINIT=0 THEN 15490
  365. 15470 IF SCR<>0 THEN 15510
  366. 15480 LINE(XMD1X,YMD1X)-(XMD2X,YMD2X),XOR,7
  367. 15490 LINE(XMD1 ,YMD1 )-(XMD2 ,YMD2 ),XOR,7
  368. 15500 XMD1X=XMD1:YMD1X=YMD1:XMD2X=XMD2:YMD2X=YMD2
  369. 15510 RETURN
  370. 15520 *秒針表示
  371. 15530 XSD1=XCLK0+(CLKR)*SIN(SCR):XSD2=XCLK0:'+(CLKR-10)*SIN(SCR)
  372. 15540 YSD1=YCLK0-(CLKR)*COS(SCR):YSD2=YCLK0:'-(CLKR-10)*COS(SCR)
  373. 15550 IF CLOCKINIT=0 THEN 15570
  374. 15560 LINE(XSD1X,YSD1X)-(XSD2X,YSD2X),XOR,4
  375. 15570 LINE(XSD1 ,YSD1 )-(XSD2 ,YSD2 ),XOR,4
  376. 15580 XSD1X=XSD1:YSD1X=YSD1:XSD2X=XSD2:YSD2X=YSD2
  377. 15590 RETURN
  378. 16000 '
  379. 19000 '
  380. 19010 '//////////////////////////////////////////////////////////////
  381. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  382. 19030 '             
  383. 19040 '
  384. 19050 IF ERR=53 THEN *IOERR
  385. 19060 IF ERR=63 THEN *FILNOF
  386. 19070 IF ERR=67 THEN *DSKFUL
  387. 19080 IF ERR=71 THEN *DSKUNF 
  388. 19090 IF ERR=72 THEN *DSKOFF
  389. 19100 IF ERR=73 THEN *DSKWP
  390. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  391. 19120 GOSUB *ERMSG
  392. 19130 STOP
  393. 19140 '////////// エラー処理
  394. 19150 *IOERR
  395. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  396. 19170 GOSUB *ERMSG:RESUME
  397. 19180 *DSKFUL
  398. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  399. 19200 GOSUB *ERMSG:RESUME
  400. 19210 *DSKUNF
  401. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  402. 19230 GOSUB *ERMSG:RESUME
  403. 19240 *DSKOFF
  404. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  405. 19260 GOSUB *ERMSG:RESUME
  406. 19270 *DSKWP
  407. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  408. 19290 GOSUB *ERMSG:RESUME
  409. 19300 *FILNOF
  410. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  411. 19320 GOSUB *ERMSG:RESUME
  412. 19330 '
  413. 19340 *ERMSG:'////////// エラーメッセージ
  414. 19350 LOCATE 2,23:COLOR 2,0
  415. 19355 PRINT SPACE$(77);
  416. 19359 LOCATE 2,23:COLOR 2,0
  417. 19360 PRINT ERMES$;"[実行]キーを押してね！";
  418. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  419. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  420. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  421. 19400 LOCATE 3,23:COLOR 6,0
  422. 19410 PRINT "エラー処理を終わります｡";SPACE$(52);
  423. 19420 RETURN
  424. 19430 '
  425. 19440 '
  426. 19450 '
  427. 20000 '------------------------------------------------------------------
  428. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "DOQSO.BAS"
  429. 20020 '------------------------------------------------------------------
  430. 20100 *表紙表示
  431. 20105  LOAD@ TIFDRV$+"\HK4IN.TIF",(0,0)
  432. 20110  FOR II=1 TO 15
  433. 20115    X=100:Y=134+19*(II-1)
  434. 20120    SYMBOL(X,Y),CFI$(II),.8!,.8!,0,,,,4
  435. 20125  NEXT II
  436. 20130  'GOSUB *初期表示ポイント検出
  437. 20145  INTERVAL ON
  438. 20160  RETURN
  439. 20190 '
  440. 20200 *本日の日付
  441. 20210  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  442. 20212  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  443. 20214  TY$=RIGHT$(STR$(TY),4)
  444. 20220  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  445. 20230  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  446. 20250  YR=TY:MN=TM:DY=TD:GOSUB *週検索:IF CW=0 THEN CW=7
  447. 20260  TYMD$=TY$+"年"+TM$+"月"+TD$+"日"+"   曜日"
  448. 20265  COLOR 7,0:LOCATE 46,1:PRINT TYMD$
  449. 20270  COLOR CW:LOCATE 61,1:PRINT WKM$
  450. 20280  RETURN
  451. 20290 '
  452. 20300 *日付表示
  453. 20310  YR$=RIGHT$(STR$(YR),4)
  454. 20315  NBN=4:NBA$=YR$:GOSUB *数字漢字変換:KYR$=NBK$
  455. 20320  MN$=RIGHT$(STR$(100+MN),2)
  456. 20325  NBN=2:NBA$=MN$:GOSUB *数字漢字変換:KMN$=NBK$
  457. 20330  DY$=RIGHT$(STR$(100+DY),2)
  458. 20335  NBN=2:NBA$=DY$:GOSUB *数字漢字変換:KDY$=NBK$
  459. 20340  GOSUB *週検索:IF CW=0 THEN CW=7
  460. 20350  DYMD$=KYR$+"       "+KMN$+"       "+KDY$+" "
  461. 20360  COLOR 6,0:LOCATE 12,3:PRINT DYMD$;
  462. 20370  COLOR CW,0:PRINT WKM$;
  463. 20375  IYM$=YR$+MN$
  464. 20380  RETURN
  465. 20390 '
  466. 20400 *指定日データ表示
  467. 20410  GOSUB *HKISRC
  468. 20420  IF FIDX=0 THEN 20450
  469. 20430  GOSUB *データ表示
  470. 20440  RETURN
  471. 20450  GOSUB *新規ファイル作成
  472. 20480  RETURN
  473. 20490  '
  474. 20495  '
  475. 20500 *データ表示
  476. 20510  RDY=DY:GOSUB *HKDGET
  477. 20520  LOCATE 12,5:COLOR 7:PRINT DEV$
  478. 20530  FOR II=1 TO 15
  479. 20532    LOCATE 20,II+6:COLOR 0:PRINT DYN$(II);"  ";DRM$(II);
  480. 20534  NEXT II
  481. 20540  IF MID$(IMAK$,DY,1)<>" " THEN 20550
  482. 20545  LOCATE 76,5:COLOR 4:PRINT "  ":GOTO *合計表示
  483. 20550  LOCATE 76,5:COLOR 4:PRINT "★":GOTO *合計表示
  484. 20555 *合計表示
  485. 20560  LOCATE 68, 8:COLOR 1:PRINT DIYN$
  486. 20562  LOCATE 68,12:COLOR 0:PRINT DBYN$
  487. 20564  LOCATE 68,20:COLOR 2:PRINT DOYN$
  488. 20580  RETURN
  489. 20590 '
  490. 20600 *年月日変更
  491. 20601  GOSUB *WEEKN
  492. 20602  DY=DY+DDEF
  493. 20604  IF DY<1 THEN MN=MN-1:GOSUB *WEEKN:DY=MNDN
  494. 20606  IF DY>MNDN THEN MN=MN+1:DY=1
  495. 20610  MN=MN+MDEF
  496. 20620  IF MN<1 THEN MN=12+MN:YR=YR-1
  497. 20630  IF MN>12 THEN MN=MN-12:YR=YR+1
  498. 20640  YR=YR+YDEF
  499. 20650  IF YR<0 THEN YR=10000+YR
  500. 20660  IF YR>9999 THEN YR=YR-10000
  501. 20665  GOSUB *WEEKN:IF DY>MNDN THEN DY=MNDN
  502. 20668  DY$=RIGHT$(STR$(100+DY),2)
  503. 20670  MN$=RIGHT$(STR$(100+MN),2)
  504. 20680  YR$=RIGHT$(STR$(10000+YR),4)
  505. 20690  RETURN
  506. 20695 '
  507. 20700 *新規ファイル作成
  508. 20710  FOR II=5 TO 22:LOCATE 12,II:PRINT SPACE$(66):NEXT II
  509. 20720  IF (YR*12+MN)=(YRM*12+MNM+1) THEN 20750:'----次月チェック
  510. 20730  MESN=7:GOSUB *MESDSP:MESN=25:GOSUB *SNDMSG
  511. 20740  FOR I=1 TO 5000:NEXT I:RETURN
  512. 20750  MESN=3:GOSUB *MESDSP:'-----------------------確認
  513. 20760  CMES$="["+YR$+"年"+MN$+"月]ファイル新規作成"
  514. 20770  GOSUB *確認
  515. 20780  ON SWNO GOTO 20800,20870
  516. 20800  MESN=5:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  517. 20810  IYM$=YR$+MN$:IMAK$=SPACE$(32):'--------------IDX追加
  518. 20820  RI=IR+1:GOSUB *HKIPUT
  519. 20830  DEV$=SPACE$(64):DDM$=SPACE$(32):'------------ファイル作成
  520. 20835  FOR JJ=1 TO 16:DYN$(JJ)=SPACE$(10):DRM$(JJ)=SPACE$(32):NEXT JJ
  521. 20840  FOR RDY=1 TO 31
  522. 20845    LOCATE 70,23:COLOR 4:PRINT RIGHT$(STR$(RDY),2);" / 31";
  523. 20850    GOSUB *HKDPUT
  524. 20860  NEXT RDY:MESN=14:GOSUB *SNDMSG
  525. 20870  RETURN
  526. 20880 '
  527. 21000 *出来事入力
  528. 21010  MESN=10:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  529. 21020  LX=12:LY=5:LC=6:LL=64:LM$=DEV$
  530. 21040  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  531. 21050  DEV$=LMG$
  532. 21060  LOCATE LX,LY:COLOR  7:PRINT DEV$
  533. 21070  RETURN
  534. 21080 '
  535. 21100 *金額･内容入力
  536. 21110  MESN=11:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  537. 21120  LX=20:LY=6+IPNO:LC=1:LL=10:LM$=DYN$(IPNO)
  538. 21140  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  539. 21150  DYN$=LMG$
  540. 21155  DYN$(IPNO)=RIGHT$(SPACE$(10)+STR$(VAL(DYN$)),10)
  541. 21160  LOCATE LX,LY:COLOR 0:PRINT DYN$(IPNO)
  542. 21170 '
  543. 21210  MESN=12:GOSUB *MESDSP
  544. 21220  LX=32:LY=6+IPNO:LC=1:LL=32:LM$=DRM$(IPNO)
  545. 21240  LOCATE LX,LY:COLOR LC:PRINT LM$:GOSUB *LKEYIN
  546. 21250  DRM$(IPNO)=LMG$
  547. 21260  LOCATE LX,LY:COLOR 0:PRINT DRM$(IPNO)
  548. 21280 '
  549. 21300  GOSUB *HKDCAL
  550. 21310  GOSUB *合計表示
  551. 21320  RETURN
  552. 21330 '
  553. 21900 '
  554. 22000 *家計簿データ保存
  555. 22010  G=1:B=8:BST(G,B)=1:GOSUB *ボタンON_OFF表示 
  556. 22020  MESN=13:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  557. 22030  RDY=DY:GOSUB *HKDPUT
  558. 22040  MID$(IMAK$,DY,1)="*"
  559. 22045  MID$(IMAK$,32,1)=" "
  560. 22050  GOSUB *HKIPUT
  561. 22060  IPF=0
  562. 22065  G=1:B=8:BST(G,B)=0:GOSUB *ボタンON_OFF表示 
  563. 22070  RETURN
  564. 22080 '
  565. 22900 '------------------------------------------------------------------
  566. 30130 *ボタン座標読み取り
  567. 30140  RESTORE *ボタン座標:READ SWGN
  568. 30150  FOR G=1 TO SWGN
  569. 30160    READ SWN(G),SMX(G),SMY(G),SMW(G)
  570. 30170    FOR B=1 TO SWN(G)
  571. 30180      READ XB1(G,B),XB2(G,B),YB1(G,B),YB2(G,B)
  572. 30190    NEXT B
  573. 30200  NEXT G
  574. 30210  RETURN
  575. 30220 '
  576. 30230 *ボタンON_OFF表示
  577. 30240  IF BST(G,B)=1 THEN BSC=7:BSB=0:BSA=2:GOTO 30260
  578. 30250                    BSC=0:BSB=7:BSA=5
  579. 30260   CONNECT(XB1(G,B  ),YB2(G,B)  )-(XB2(G,B)  ,YB2(G,B)  )-(XB2(G,B  ),YB1(G,B)  ),BSC,PSET
  580. 30270   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB2(G,B)-1,YB2(G,B)-1)-(XB2(G,B)-1,YB1(G,B)+1),BSC,PSET
  581. 30280   CONNECT(XB1(G,B)  ,YB2(G,B)  )-(XB1(G,B)  ,YB1(G,B)  )-(XB2(G,B)  ,YB1(G,B)  ),BSB,PSET
  582. 30290   CONNECT(XB1(G,B)+1,YB2(G,B)-1)-(XB1(G,B)+1,YB1(G,B)+1)-(XB2(G,B)-1,YB1(G,B)+1),BSB,PSET
  583. 30300   LINE(XB1(G,B)+4,YB1(G,B)+4)-(XB1(G,B)+6,YB1(G,B)+5),PSET,BSA,BF
  584. 30305   IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT 16
  585. 30310  RETURN
  586. 30320 '
  587. 30330 *マウスボタン選択
  588. 30340  SWERC=0
  589. 30350  IF MOUSE(2,0)=0 THEN 30350
  590. 30360  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):SWNO=0
  591. 30370  FOR IMS=1 TO SWN(G)
  592. 30380    IF (X_M>XB1(G,IMS) AND X_M<XB2(G,IMS)) ELSE 30410
  593. 30390    IF (Y_M>YB1(G,IMS) AND Y_M<YB2(G,IMS)) ELSE 30410
  594. 30400    SWNO=IMS:IMS=SWN(G)+1
  595. 30410  NEXT IMS:FOR IM=1 TO 500:NEXT IM
  596. 30420  IF SWNO=0 AND SWPASS=1 THEN GOSUB *シート選択判定:GOTO 30460
  597. 30430  IF SWNO=0 AND SWERC>5  THEN MESN=12:GOSUB *SNDMSG       :GOTO 30350
  598. 30440  IF SWNO=0              THEN SMSGPLAY 3:SWERC=SWERC+1:GOTO 30350
  599. 30460  SWPASS=0
  600. 30470  RETURN
  601. 30480 '
  602. 30500 *数字漢字変換
  603. 30505  NBK$=""
  604. 30510  FOR INBK=1 TO NBN
  605. 30512    NBAX$=MID$(NBA$,INBK,1)
  606. 30514    IF NBAX$=" " THEN NBK$=NBK$+"　":GOTO 30530
  607. 30520    NBK$=NBK$+KNJ$(&H2330+VAL(NBAX$))
  608. 30530  NEXT INBK
  609. 30540  RETURN
  610. 30580 '
  611. 30760 '
  612. 30820 *シート選択判定
  613. 30880  RETURN
  614. 30890 '
  615. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  616. 31010  FOR II=0 TO 15
  617. 31020    PALETTE II,[16*II,16*II,16*II]
  618. 31030  NEXT II
  619. 31040  FOR II=0 TO 255 STEP 5
  620. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  621. 31054      PALETTE JJ,[KK,KK,KK]
  622. 31056    NEXT JJ
  623. 31060  NEXT II
  624. 31070  RETURN
  625. 31080 '
  626. 31200 *確認
  627. 31205  LOCATE 27,3:PRINT SPACE$(52)
  628. 31210  GET@A(214,50)-(630,79),CUTN#
  629. 31220  LOAD@ TIFDRV$+"\CAUTION.TIF",(214,50)
  630. 31225  PLAY "o6l4ce"
  631. 31230  FOR II=1 TO 4
  632. 31232    LOCATE 40,3:COLOR 6:PRINT CMES$;:'28chr
  633. 31234    WAIT SWAIT/10
  634. 31236    LOCATE 40,3:PRINT SPACE$(28)
  635. 31237    WAIT SWAIT/10
  636. 31238  NEXT II
  637. 31239  LOCATE 40,3:COLOR 7:PRINT CMES$;:MESN=19:GOSUB *SNDMSG:'28chr
  638. 31240  G=2:GOSUB *マウスボタン選択
  639. 31245  G=2:B=SWNO:BST(G,B)=1:GOSUB *ボタンON_OFF表示
  640. 31250  LOCATE 40,3:PRINT SPACE$(28)
  641. 31260  WAIT SWAIT/5
  642. 31270  PUT@A(214,50)-(630,79),CUTN#
  643. 31272  GOSUB *日付表示
  644. 31275  RETURN
  645. 31280 '
  646. 35000 *HKIOPN:'---------- インデックスファイルオープン
  647. 35005  DRV$=LEFT$(DATDRV$,2)
  648. 35010  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35020
  649. 35015  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  650. 35020  FLN$=DRV$+"(38)"+PATH$+"\HLIDX.DAT"
  651. 35030  OPEN "R",#2,FLN$
  652. 35040  FIELD #2,6 AS I$(1),32 AS I$(2)
  653. 35050  IR=LOF(2)
  654. 35060  RETURN
  655. 35070 '
  656. 35100 *HKDOPN:'---------- 家計簿データファイルオープン
  657. 35105  DRV$=LEFT$(DATDRV$,2)
  658. 35110  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35120
  659. 35115  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  660. 35120  FLN$=DRV$+"(768)"+PATH$+"\HL"+IYM$+".DAT"
  661. 35130  OPEN "R",#1,FLN$
  662. 35140  FIELD #1,64 AS D$(1),10*16 AS D$(2),32*4 AS D$(3),32*4 AS D$(4),32*4 AS D$(5),32*4 AS D$(6),32 AS D$(7)
  663. 35150  AR=LOF(1)
  664. 35160  RETURN
  665. 35170 '
  666. 36000 *HKISRC:'---------- インデックスファイル検索
  667. 36005  FIDX=0
  668. 36010  GOSUB *HKIOPN
  669. 36020  FOR R=1 TO IR
  670. 36030    GET #2,R
  671. 36040    IF IYM$<>I$(1) THEN 36060
  672. 36050    IYM$=I$(1):IMAK$=I$(2):RI=R:R=IR+1:FIDX=1
  673. 36060  NEXT R
  674. 36062  GET #2,IR
  675. 36064  YRM=VAL(LEFT$(I$(1),4)):MNM=VAL(RIGHT$(I$(1),2))
  676. 36070  CLOSE #2
  677. 36080  RETURN
  678. 36090 '
  679. 36100 *HKIPUT:'---------- インデックスファイル書き込み
  680. 36110  GOSUB *HKIOPN
  681. 36120  LSET I$(1)=IYM$
  682. 36130  LSET I$(2)=IMAK$
  683. 36140  PUT #2,RI
  684. 36150  CLOSE #2
  685. 36160  RETURN
  686. 36170 '
  687. 36200 *HKDGET:'---------- 家計簿データ読み込み
  688. 36210  GOSUB *HKDOPN
  689. 36220  R=RDY
  690. 36230  GET #1,R
  691. 36240  DEV$=D$(1)
  692. 36250  FOR II=1 TO 16:DYN$(II   )=MID$(D$(2),(II-1)*10+1,10):NEXT II
  693. 36252  FOR II=1 TO  4:DRM$(II+ 0)=MID$(D$(3),(II-1)*32+1,32):NEXT II
  694. 36253  FOR II=1 TO  4:DRM$(II+ 4)=MID$(D$(4),(II-1)*32+1,32):NEXT II
  695. 36254  FOR II=1 TO  4:DRM$(II+ 8)=MID$(D$(5),(II-1)*32+1,32):NEXT II
  696. 36255  FOR II=1 TO  4:DRM$(II+12)=MID$(D$(6),(II-1)*32+1,32):NEXT II
  697. 36256  DDM$=D$(7)
  698. 36260  GOSUB *HKDCAL
  699. 36280  CLOSE #1
  700. 36290  RETURN
  701. 36295 '
  702. 36300 *HKDPUT:'---------- 家計簿データ書き込み
  703. 36310  GOSUB *HKDOPN
  704. 36320  R=RDY
  705. 36330  LSET D$(1)=DEV$
  706. 36340  DX$="":FOR II=1 TO 16:DX$=DX$+DYN$(II   ):NEXT II:LSET D$(2)=DX$
  707. 36342  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 0):NEXT II:LSET D$(3)=DX$
  708. 36343  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 4):NEXT II:LSET D$(4)=DX$
  709. 36344  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 8):NEXT II:LSET D$(5)=DX$
  710. 36345  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+12):NEXT II:LSET D$(6)=DX$
  711. 36346  LSET D$(7)=DDM$
  712. 36350  PUT #1,R
  713. 36360  CLOSE #1
  714. 36370  RETURN
  715. 36380 '
  716. 36400 *HKDCAL:'---------- 家計簿金額計算
  717. 36410  FOR II=1 TO 16:DYN(II)=VAL(DYN$(II)):NEXT II
  718. 36420  DIYN=0:FOR II=1 TO 3 :DIYN=DIYN+DYN(II):NEXT II
  719. 36430  DIYN$=RIGHT$(SPACE$(8)+STR$(DIYN),8)
  720. 36440  DBYN=0:FOR II=4 TO 7 :DBYN=DBYN+DYN(II):NEXT II
  721. 36450  DBYN$=RIGHT$(SPACE$(8)+STR$(DBYN),8)
  722. 36460  DOYN=0:FOR II=4 TO 15:DOYN=DOYN+DYN(II):NEXT II
  723. 36480  DOYN$=RIGHT$(SPACE$(8)+STR$(DOYN),8)
  724. 36490  RETURN
  725. 37190 '
  726. 37290 '
  727. 39000 *CONFIGファイルチェック'  V10 1993.02.07
  728. 39010  OPEN "R",#1,"(1)HK.CFG"
  729. 39020  FIELD #1,1 AS D$
  730. 39030  IF LOF(1)=0 THEN *CFGFE1
  731. 39035  CLOSE
  732. 39040  OPEN "I",#1,"HK.CFG"
  733. 39050  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$
  734. 39052  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$
  735. 39054  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$
  736. 39056  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$
  737. 39058  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$
  738. 39060  GOSUB *CFGREAD             :'-- SNDMF
  739. 39062    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  740. 39064    SNDMF=VAL(RIGHT$(CFG$,1))
  741. 39066  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$
  742. 39068  GOSUB *CFGREAD             :'-- SWAIT
  743. 39070    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  744. 39072    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  745. 39080  FOR II=1 TO 15
  746. 39082    GOSUB *CFGREAD:CFI$(II)=CFG$
  747. 39084  NEXT II
  748. 39140  CLOSE
  749. 39150  RETURN
  750. 39200 *CFGFE1
  751. 39220  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  752. 39230  CLOSE:WAIT 100:SYSTEM
  753. 39300 *CFGFE2
  754. 39320  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの内容に誤りがあります｡ 家計簿を終了します｡"
  755. 39330  CLOSE:WAIT 100:SYSTEM
  756. 39400 *CFGFE3
  757. 39420  LOCATE 2,23:COLOR 6:PRINT "HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  758. 39430  CLOSE:WAIT 100:SYSTEM
  759. 39500 *CFGREAD
  760. 39510  IF EOF(1)<>0 THEN *CFGFE3
  761. 39520  LINE INPUT #1,CFG$
  762. 39530  IF LEFT$(CFG$,1)="/" THEN 39510
  763. 39540  RETURN
  764. 39990 '
  765. 40000 *ボタン座標:'-------------------------------------------------------
  766. 40010 DATA 2   'SWGN        スイッチグループ数 
  767. 40090 '/////////////////////////////
  768. 40100 '-------------------- スイッチグループ[1]
  769. 40110 '    SWN(G),SMX,SMY,SMW
  770. 40120 DATA    25 ,  1,  1, 0
  771. 40130 '    XB1 XB2 YB1 YB2 SWM$     SMC SWNO.
  772. 40140 DATA 163,182, 56, 73'," ▲   ",7   01
  773. 40150 DATA 183,202, 56, 73'," ▼   ",7   02 
  774. 40160 DATA 251,270, 56, 73'," ▲   ",7   03
  775. 40170 DATA 271,290, 56, 73'," ▼   ",7   04 
  776. 40180 DATA 364,383, 56, 73'," ▲   ",7   05
  777. 40190 DATA 384,403, 56, 73'," ▼   ",7   06
  778. 40200 DATA 515,568, 56, 79',"取  消",1   08
  779. 40210 DATA 569,624, 56, 79',"保  存",1   09
  780. 40220 DATA 592,630,  3, 41'," END  ",1   07
  781. 40230 DATA  14, 88, 94,116',"出来事",0   10
  782. 40240 DATA  90,155,131,149',"給　与",1   11
  783. 40250 DATA  90,155,150,168',"臨　時",1   12
  784. 40260 DATA  90,155,169,187',"他収入",1   13
  785. 40270 DATA  90,155,188,206',"食　費",0   14
  786. 40280 DATA  90,155,207,225',"生活費",0   15
  787. 40290 DATA  90,155,226,244',"洗濯代",0   16
  788. 40300 DATA  90,155,245,263',"光熱費",0   17
  789. 40310 DATA  90,155,264,282',"被服費",0   18
  790. 40320 DATA  90,155,283,301',"交際費",0   19
  791. 40330 DATA  90,155,302,320',"娯楽費",0   20
  792. 40340 DATA  90,155,321,339',"酒　代",0   21
  793. 40350 DATA  90,155,340,358',"車維持",0   22
  794. 40360 DATA  90,155,359,377',"教育費",0   23
  795. 40370 DATA  90,155,378,396',"雑　費",0   24
  796. 40380 DATA  90,155,397,415',"他支出",0   25
  797. 40500 '-------------------- スイッチグループ[2]
  798. 40510 '    SWN(G),SMX,SMY,SMW
  799. 40520 DATA     2 ,0.8,0.8,  0
  800. 40530 '    XB1 XB2 YB1 YB2 SWM$         SMC
  801. 40540 DATA 552,583, 56, 73',"  OK  ",1   01
  802. 40550 DATA 584,615, 56, 73',"  NG  ",1   02
  803. 60000 '
  804. 60010 ' 座標確認 DEBUG ROUTINE
  805. 60020 '
  806. 60030 MOUSE 0:MOUSE 1,0,0,1
  807. 60040  IF MOUSE(2,1)<>0 THEN STOP
  808. 60050  IF MOUSE(2,0)=0 THEN 60050
  809. 60060  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  810. 60070  LOCATE 2,24:COLOR 7:PRINT "X=";X_M,"Y=";Y_M,"LX=";LX,"LY=";LY;
  811. 60080  GOTO 60040
  812. 61000 ' 
  813.